home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d17
/
slash0.arc
/
SLASH0.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1990-01-20
|
13KB
|
372 lines
PROGRAM SLASH0; {Copyright 1989 by E.C. Weber}
{All rights reserved}
{Version 1.1 adds left margin feature 01/14/89}
USES PRINTER,
CRT;
TYPE String4=STRING[4];
VAR Param:ARRAY[1..4] OF String4 {command line parameter};
i: INTEGER; {counter}
Margin: REAL; {left margin in Pica characters}
InMargin: REAL; {left margin in inches}
Result: INTEGER; {needed for syntax but not used in the program}
CheckBreak:BOOLEAN;
PROCEDURE ErrorMessage;
BEGIN {ErrorMessage}
WRITELN('SLASH0 [parameter1] [parameter2] [parameter3] [parameter4]');
WRITELN;
WRITELN('Where [parameter1] is D for draft, S for Sans Serif, R for Roman, or H for');
WRITELN('Help. [parameter2] is 10, 12, or PS. [parameter3] is N for normal or C for');
WRITELN('Condensed. If [parameter3] is omitted, Normal is the default. [parameter4]');
WRITELN('is the left margin in inches. [parameter4] can have a value between 0 and 4.5;');
WRITELN('if it is omitted, the default is 1.0 inch. If all parameters are omitted, the');
WRITELN('defaults are equivalent to SLASH0 D 12 N 1.',#13,#10);
IF (COPY(Param[1],1,1) <>'H') THEN HALT;
END{ErrorMessage};
PROCEDURE Help;
BEGIN{Help}
ClrScr;
FOR i:=1 TO 80 DO WRITE('=');
WRITELN(' SLASH0.EXE FOR THE EPSON LQ-850 AND COMPATIBLES');
WRITELN(' by Ed Weber Ver 1.1 c1989');
FOR i:=1 TO 80 DO WRITE('=');
WRITELN('The program is executed at the DOS prompt by typing: '#10,#13);
WRITE(' ');
ErrorMessage;
WRITELN('15 CPI is not supported. Proportional spacing may or may not be satisfactory,') ;
WRITELN('depending on the application driver. The program selects the font style, pitch,');
WRITELN('and condensed/normal from the parameters and sends the proper codes to the');
WRITELN('printer. ESC % 1, the code required to activate the RAM character set, is sent');
WRITELN('to the printer; however, the printer drivers in many applications cancel this') ;
WRITELN('code when they initialize the printer. In this case, it will be necessary to');
WRITELN('re-send ESC % 1 to the printer from within the application, embedded at the');
WRITELN('top of document.');
HALT;
END{Help};
PROCEDURE CheckParam (CheckParam1:String4;CheckParam2:String4;
CheckParam3:String4;CheckParam4:String4;
LeftMargin:INTEGER);
VAR i:INTEGER; {counter}
MarginError:BOOLEAN;
PitchError:BOOLEAN;
FontError:BOOLEAN;
SizeError:BOOLEAN;
BEGIN {CheckParam}
MarginError:=FALSE; PitchError:=TRUE;
FontError:=TRUE; SizeError:=TRUE;
IF (CheckParam1='D') OR (CheckParam1='S') OR (CheckParam1='R') THEN
FontError:=FALSE;
IF (CheckParam2='10')OR(CheckParam2='12')OR(CheckParam2='PS') THEN
PitchError:=FALSE;
IF (CheckParam3='N') OR (CheckParam3='C') THEN
SizeError:=FALSE;
FOR i:= 1 TO LENGTH(CheckParam4) DO
BEGIN
IF((COPY(CheckParam4,i,1)>'9') OR (COPY(CheckParam4,i,1)<'0'))AND
NOT(COPY(CheckParam4,i,1)='.') THEN
MarginError:=TRUE;
END;
IF (LeftMargin>45) OR PitchError OR MarginError OR FontError
OR SizeError THEN
BEGIN
WRITE('Error in:');
IF FontError THEN WRITE(' [parameter1]');
IF PitchError THEN WRITE(' [parameter2]');
IF SizeError THEN WRITE(' [parameter3]');
IF (LeftMargin>45) THEN WRITE(' [margin value]');
IF MarginError THEN WRITE(' [margin parameter]');
WRITELN;
WRITELN;
WRITELN('Correct form is:');
WRITELN;
SOUND(800);DELAY(500);NOSOUND;
ErrorMessage;
END;
END {CheckParam};
PROCEDURE TestPrinter; {Is it on or off? NB: This is not a printer status}
{check. It will not detect paper-out or off-line }
VAR a:CHAR; {conditions}
BEGIN{TestPrinter}
{$i-}
WRITE(LST,#0);
IF IORESULT<>0 THEN
BEGIN{printer off}
Sound(800);Delay(500);NoSound;
WRITELN(#10,#13,'Printer is Off');
WRITELN('Turn On Printer then Press <ENTER> to continue or');
WRITELN('Any other key to quit');
a:=READKEY;
IF a=#13 THEN TestPrinter
ELSE HALT
END;{printer off}
END;{TestPrinter}
PROCEDURE Draft;
BEGIN{Draft}
WRITE('Draft ');
IF Param[2]='PS' THEN Param[2]:='12'; {there is no draft ps}
WRITE(LST,#27,'x'#0); {select draft}
IF Param[2]='10' THEN
BEGIN
WRITE(LST,#27,'P'); {select 10 CPI}
WRITE ('10 CPI');
END;
IF Param[2]='12' THEN
BEGIN
WRITE(LST,#27,'M'); {select 12 CPI}
WRITE('12 CPI');
END;
WRITE(LST,#$1B,':',#0,#0,#0); {load rom into ram}
WRITE(LST,#$1B,'&',#0,'00'); {state which characters}
WRITE(LST,#1,#9,#2); {how many bytes of data?}
{data which describes the character follows}
WRITE(LST,
{Column 1} #1,#253,#0,
{2} #6,#2,#192,
{3} #8,#4,#32,
{4} #16,#8,#16,
{5} #8,#16,#32,
{6} #16,#32,#16,
{7} #8,#64,#32,
{8} #6,#128,#192,
{9} #1,#127,#0);
END;{Draft}
PROCEDURE LetterQual;
BEGIN{LetterQual}
WRITE(LST,#27,'&',#0,'00'); {state which characters}
WRITE(LST,#3,#23,#3); {how many bytes of data?}
{data which describes the character follows. It is broken into two}
{lines to accomodate the TURBO PASCAL 5.0 debugger}
WRITE(LST,
{Column 1} #1,#255,#0,
{2} #2,#0,#128,
{3} #5,#255,#64,
{4} #10,#0,#160,
{5} #4,#3,#64,
{6} #24,#0,#48,
{7} #0,#6,#0,
{8} #16,#0,#16,
{9} #32,#12,#8,
{10} #16,#0,#16,
{11} #32,#24,#8);
WRITE(LST,
{12} #16,#0,#16,
{13} #32,#48,#8,
{14} #16,#0,#16,
{15} #32,#96,#8,
{16} #16,#0,#16,
{17} #0,#192,#0,
{18} #24,#0,#48,
{19} #5,#128,#64,
{20} #10,#0,#160,
{21} #5,#255,#64,
{22} #2,#0,#128,
{23} #1,#255,#0);
END;{LetterQual}
FUNCTION UpperCase(ParamX:String4):String4; {convert any letters in}
{Params to uppercase }
VAR Temp1:String4; {variables to temporarily hold parameters}
Temp2:String4; {during processing}
i:INTEGER;
BEGIN {UpperCase}
Temp1:='';
Temp2:='';
FOR i:=1 TO length(ParamX) DO
BEGIN
Temp1:=COPY(ParamX,i,1);
Temp2:=Temp2 + UPCASE(Temp1[1]);
END;
UpperCase:=Temp2
END;{UpperCase}
PROCEDURE SelectPitch (PitchParam:String4);
BEGIN{SelectPitch}
IF PitchParam='10' THEN
BEGIN
WRITE(LST,#27,'P'); {select 10 CPI}
WRITE(' 10 CPI');
END;
IF PitchParam='12' THEN {select 12 CPI}
BEGIN
WRITE(LST,#27,'M');
WRITE(' 12 CPI');
END;
IF PitchParam='PS' THEN {Select PS}
BEGIN
WRITE(LST,#27,#112,#1);
WRITE(' Proportional');
END;
END;{SelectPitch}
{**************************************************************************}
{********************** MAIN ***********************}
{**************************************************************************}
BEGIN{Program SLASH0}
CheckBreak:=FALSE;
{ <<<< Get Parameters and convert to uppercase >>>> }
IF PARAMCOUNT<5 THEN
BEGIN
FOR i:=1 TO PARAMCOUNT DO
BEGIN
Param[i]:=PARAMSTR(i);
Param[i]:=UpperCase(Param[i]);
END;
END;
{ <<<< If first parameter=Help then call for help >>>> }
IF (COPY(Param[1],1,1)='H') THEN Help;
{ <<<< Too many parameters: Error >>>> }
IF PARAMCOUNT>4 THEN {too many parameters}
BEGIN
Sound(800);Delay(500);NoSound;
WRITELN('Too many parameters - a maximum of four is allowed:'#10,#13);
ErrorMessage;
END;
{ <<<< Set Defaults >>>> }
IF PARAMCOUNT=0 THEN
BEGIN
Param[1]:='D';
Param[2]:='12';
Param[3]:='N';
Param[4]:='1.0'
END;
IF PARAMCOUNT=1 THEN
BEGIN
Param[2]:='12'; {no parameter2 so set default to 12}
Param[3]:='N'; { " parameter3 " " " " N }
Param[4]:='1.0'; { " parameter4 " " " " 1 }
END;
IF PARAMCOUNT= 2 THEN {no parameter3 or parameter 4 so set defaults}
BEGIN
Param[3]:='N';
Param[4]:='1.0';
END;
IF PARAMCOUNT=3 THEN {get the N/C parameter and the }
{ margin parameter into the proper variable}
BEGIN
IF (COPY(Param[3],1,1)>='A') AND (COPY(Param[3],1,1)<='z') THEN
BEGIN {Param[3] is not a number}
Param[4]:='1.0'; {set default margin}
END;
{If Param[3] is a number then adjust Param[3] and Param[4]}
IF ((COPY(Param[3],1,1)>'/') AND (COPY(Param[3],1,1) < ':'))
OR
(COPY(Param[3],1,1)='.')
THEN
BEGIN
Param[4]:=Param[3]; {place left margin in Param[4]}
Param[3]:='N'; {set default to N}
END;
END;
{ <<<< Convert Param[2](the margin in inches) from string to integer >>> }
{ <<<< Convert margin from inches to characters >>>> }
VAL(Param[4],InMargin,Result);
Margin:=InMargin*10;
{ <<<< Screen Display >>>> }
WRITELN;
WRITELN('=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=');
WRITELN('SLASH0.EXE Version 1.1 by Ed Weber c1989');
WRITELN('=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=');
WRITELN;
TestPrinter; {Is the printer turned on?}
CheckParam(Param[1],Param[2],Param[3],Param[4],ROUND(Margin));
{check validity of parameters}
WRITE(LST,#27,'@'); {initialize the printer}
write(lst,#27,#108,CHR(ROUND(Margin)));
IF Param[1] = 'D' THEN Draft; {Process Draft}
IF Param[1] = 'S' THEN {Process Sans Serif}
BEGIN{Sans Serif}
WRITE('Sans Serif');
WRITE(LST,#27,'x',#1); {select LQ}
WRITE(LST,#27,'k',#1); {select Sans Serif}
SelectPitch(Param[2]); {process Param[2]}
WRITE(LST,#27,':',#0,#1,#0); {ROM to RAM}
LetterQual; {call the data FOR LQ zero}
END;{Sans Serif}
IF Param[1] = 'R'THEN {Roman}
BEGIN{Roman}
WRITE('Roman');
WRITE(LST,#27,'x',#1); {select LQ}
WRITE(LST,#27,'k',#0); {select Roman}
SelectPitch(Param[2]);
WRITE(LST,#27,':',#0,#0,#0); {ROM to RAM}
LetterQual;
END;{Roman}
IF Param[3]='C' THEN {condensed}
BEGIN
WRITE(LST,#15);
WRITE(' Condensed');
END;
IF Param[3]='N' THEN {normal}
BEGIN
WRITE(LST,#16);
END;
WRITELN(' slashed zero character downloaded.');{announce results}
WRITELN('Left Margin is set to ',Param[4],' inches.');
IF PARAMCOUNT=0 THEN {remind user about getting help}
BEGIN
WRITELN('Defaults for all parameters were used.');
WRITELN('For parameter information, type SLASH0 HELP and press <ENTER>.');
END;
WRITE(LST,#27,'%',#1); {activate RAM character set}
END.{Program Slash0} {******ALL DONE******}